home *** CD-ROM | disk | FTP | other *** search
- %=====================================================================
- %----Linda muProlog Tuple Server
- %----
- %----Written by Geoff Sutcliffe, 29/11/89
- %=====================================================================
- %----. defined as a postfix operator for writing terms atomically
- ?-op(100,xf,.).
- %=====================================================================
- %----Procedures for control of the server
- %=====================================================================
- %----Start the server, with a goal and its Prolog file
- go(Goal,File):-
- pipe(Read_request_channel,Write_request_channel),
- asserta(write_request_channel(Write_request_channel)),
- asserta(read_request_channel(Read_request_channel)),
- server_eval(Goal,File),
- serve(Read_request_channel).
-
- clear_template(go(_,_)).
- %---------------------------------------------------------------------
- %----Read the request channel and execute each request
- serve(Read_request_channel):-
- read(Read_request_channel,Request),
- %debug write('*** Request received '),writeln(Request),
- Request,
- !,
- serve(Read_request_channel).
-
- %----If a request fails, then output
- serve(_):-
- writeln('Error, a request failed'),
- exit(-1).
-
- clear_template(serve(_)).
- %=====================================================================
- %----Procedures for doing eval requests
- %=====================================================================
- %----Count number of clients
- clients(0).
- %---------------------------------------------------------------------
- %----Increment client count
- increment_clients:-
- retract(clients(Number_of_clients)),
- New_number_of_clients is Number_of_clients + 1,
- asserta(clients(New_number_of_clients)).
- %---------------------------------------------------------------------
- %----Decrement client count and stop server if no clients
- decrement_clients:-
- retract(clients(Number_of_clients)),
- New_number_of_clients is Number_of_clients - 1,
- stop_server_if_no_clients(New_number_of_clients).
- %---------------------------------------------------------------------
- %----Stop the server if there are no clients, otherwise record number
- stop_server_if_no_clients(0):-
- exit(0).
-
- stop_server_if_no_clients(New_number_of_clients):-
- asserta(clients(New_number_of_clients)).
- %---------------------------------------------------------------------
- %----Start a new query in a Prolog file
- %----Open a reply pipe and continue
- server_eval(Goal,File):-
- pipe(Read_reply_channel,Write_reply_channel),
- server_do_eval(Goal,File,Read_reply_channel,Write_reply_channel).
-
- clear_template(server_eval(_,_)).
- %---------------------------------------------------------------------
- %----Start new process, load file, execute query and clean up
- %----This is the parent version, close reply channel
- server_do_eval(_,_,Read_reply_channel,_):-
- fork,
- close(Read_reply_channel).
-
- %----This is the child version, where the new query executes
- server_do_eval(Goal,File,Read_reply_channel,Write_reply_channel):-
- %----Need to remove all the server tuples
- clear_database,
- asserta(write_reply_channel(Write_reply_channel)),
- asserta(read_reply_channel(Read_reply_channel)),
- close(Write_reply_channel),
- retract(read_request_channel(Read_request_channel)),
- %----This commented out, as it's causing the server to die!!!
- % close(Read_request_channel),
- consult(client),
- consult(File),
- Goal,
- %----Tell server to close the reply channel for this process
- send_request(close(Write_reply_channel)),
- send_request(decrement_clients),
- %----Close the channels locally
- retract(write_request_channel(Write_request_channel)),
- close(Write_request_channel),
- close(Read_reply_channel),
- exit(0).
-
- clear_template(server_do_eval(_,_,_,_)).
- %---------------------------------------------------------------------
- %----Remove all tuples
- clear_database:-
- repeat,
- not(remove_templated_clauses),
- retractall(remove_templated_clauses),
- retractall(clear_database).
- %---------------------------------------------------------------------
- %----Remove all tuples and the template, for the template
- remove_templated_clauses:-
- clear_template(Template),
- retractall(Template),
- retract(clear_template(Template)).
- %---------------------------------------------------------------------
- %----Prevent error messages when there are no tuples
- traperror(enoproc,clear_template(_),fail).
-
- clear_template(traperror(_,_,_)).
- %---------------------------------------------------------------------
- %=====================================================================
- %----Procedures for out requests
- %=====================================================================
- %----Execute out, checking for any ins and rds waiting for the tuple
- server_out(Tuple):-
- assertz(Tuple),
- save_tuple_information(Tuple),
- findall(Suitable_request,suitable_waiting_request(Tuple,
- Suitable_request),Waiting_requests),
- %debug write('*** Waiting requests '),writeln(Waiting_requests),
- doall(Waiting_requests).
-
- clear_template(server_out(_)).
- %---------------------------------------------------------------------
- %----Save information about existing tuples, so they can be removed
- save_tuple_information((Tuple:-_)):-
- !,
- save_head_information(Tuple).
-
- save_tuple_information(Tuple):-
- save_head_information(Tuple).
-
- clear_template(save_tuple_information(_)).
- %---------------------------------------------------------------------
- %----Make a template and save as such
- %----First check if such information already exists
- save_head_information(Tuple):-
- clear_template(Tuple),
- !.
-
- save_head_information(Tuple):-
- functor(Tuple,Symbol,Arity),
- functor(Template,Symbol,Arity),
- assertz(clear_template(Template)).
-
- clear_template(save_head_information(_)).
- %---------------------------------------------------------------------
- %----Find requests that may be satisfied by the new clause.
- suitable_waiting_request(Tuple,Suitable_request):-
- waiting(Requested_tuple,Suitable_request),
- suitable(Requested_tuple,Suitable_request,Tuple),
- retract(waiting(Requested_tuple,Suitable_request)).
-
- clear_template(suitable_waiting_request(_,_)).
- %---------------------------------------------------------------------
- %----Check if waiting request is suitable at all
- %----Any rd request that can use a rule is suitable
- suitable(Requested_tuple,rd(Requested_tuple,_),_):-
- clause(Requested_tuple,_),
- !.
-
- %----Any request that can unify with the new tuple is suitable
- suitable(Requested_tuple,_,Requested_tuple).
-
- clear_template(suitable(_,_,_)).
- %---------------------------------------------------------------------
- %----Prevent error messages when nothing is waiting
- traperror(enoproc,waiting(_,_),fail).
- %=====================================================================
- %----Procedures for in requests
- %=====================================================================
- %----Execute in, if not possible then put on waiting queue
- server_in(Tuple,Reply_channel):-
- retract(Tuple),
- !,
- write_term(Reply_channel,Tuple).
-
- server_in(Tuple,Reply_channel):-
- assertz(waiting(Tuple,server_in(Tuple,Reply_channel))).
-
- clear_template(server_in(_,_)).
- %=====================================================================
- %----Procedures for inp requests
- %=====================================================================
- %----Execute in, if not possible then return fail
- server_inp(Tuple,Reply_channel):-
- retract(Tuple),
- !,
- write_term(Reply_channel,Tuple).
-
- server_inp(_,Reply_channel):-
- write_term(Reply_channel,fail).
-
- clear_template(server_inp(_,_)).
- %=====================================================================
- %----Procedures for rd requests
- %=====================================================================
- %----Execute rd if not possible then put on waiting queue
- server_rd(Tuple,Reply_channel):-
- Tuple,
- !,
- write_term(Reply_channel,Tuple).
-
- server_rd(Tuple,Reply_channel):-
- assertz(waiting(Tuple,server_rd(Tuple,Reply_channel))).
-
- clear_template(server_rd(_,_)).
- %=====================================================================
- %----Procedures for rdp requests
- %=====================================================================
- %----Execute rd if not possible then return fail
- server_rdp(Tuple,Reply_channel):-
- Tuple,
- !,
- write_term(Reply_channel,Tuple).
-
- server_rdp(Tuple,Reply_channel):-
- write_term(Reply_channel,fail).
-
- clear_template(server_rdp(_,_)).
- %=====================================================================
- %----Utilities
- %=====================================================================
- %----Write a term with a . - horrible hack to get an atomic write
- write_term(Channel,Term):-
- Structure =.. ['.',Term],
- writeln(Channel,Structure).
-
- clear_template(write_term(_,_)).
- %---------------------------------------------------------------------
- %----Fast findall implementation
- findall(Variable,Goal,List):-
- repeat,
- not(do_findall(Variable,Goal)),
- !,
- collectall(List).
-
- clear_template(findall(_,_,_)).
- %---------------------------------------------------------------------
- do_findall(Variable,Goal):-
- Goal,
- asserta(found(Variable)).
-
- clear_template(do_findall(_,_)).
- %---------------------------------------------------------------------
- collectall([This_one|Rest]):-
- retract(found(This_one)),
- !,
- collectall(Rest).
-
- collectall([]).
-
- clear_template(collectall(_)).
- %---------------------------------------------------------------------
- %----Execute every goal in the list
- doall([]).
-
- doall([Goal|Rest]):-
- Goal,
- doall(Rest).
-
- clear_template(doall(_)).
- %---------------------------------------------------------------------
-